home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_oth / ada / demo.aug < prev    next >
Text File  |  1985-07-06  |  3KB  |  87 lines
  1. Pragma crt(ON); -- list output to screen
  2.  
  3. -- Augusta Demonstration Program
  4. -- written by Edward Mitchell, 29 July, 1982
  5.  
  6. Procedure NumGuess is
  7.   lowbnd   : integer;    -- the lower bound of the guessing interval
  8.   hibnd    : integer;    -- the upper bound
  9.   again    : boolean;    -- false when the user wants to quit
  10.   ch       : character;  -- dummy variable for input
  11.   s        : string;     -- dummy string for input
  12.   nguesses : integer;    -- # of guesses made by computer
  13.  
  14. function Guesser return integer is
  15.   response : integer;   -- player's hi, lo or equal response
  16.   count    : integer;   -- counts the number of guesses
  17.   guess    : integer;   -- the guess
  18.   lastguess: integer;   -- the previous guess
  19. begin
  20.   count := 1;           -- initialize some stuff
  21.   guess := 0;
  22.   loop
  23.     lastguess := guess;
  24.     guess := (lowbnd + hibnd) / 2;      -- uses a binary search
  25.  
  26.     if lastguess = guess then
  27.       putline ("You messed up your entries!  I guarantee");
  28.       putline ("to guess your number in less than 11 moves");
  29.       putline ("but you entered a wrong response! and that");
  30.       putline ("really upsets me.  I never make mistakes");
  31.       putline ("like that . . .");
  32.       return count;
  33.     end if;
  34.  
  35.     newline; newline;
  36.     putstr("Guess # ");
  37.     putint(count);
  38.     putstr("   Computer's guess = ");
  39.     putint(guess); newline;
  40.  
  41.     putstr("Enter:  1=Too high,  2=Too low,  3=Equal or Quit ? ");
  42.     getint(@response);
  43.  
  44.     case response is
  45.       when 1 => hibnd := guess - 1;
  46.       when 2 => lowbnd := guess + 1;
  47.       when 3 => return count;
  48.       when others => putline("Invalid input ignored");
  49.     end case;
  50.  
  51.     count := count + 1;
  52.  
  53.   end loop;
  54.  
  55. end;  -- of function Guesser
  56.  
  57.  
  58. begin -- procedure Guessnum
  59.   again := true;
  60.   putline("Number Guessing Game"); newline;
  61.   putline("Choose a number between 1 and 1000 and the");
  62.   putline("computer will try to guess your choice.");
  63.  
  64.   while again
  65.   loop
  66.  
  67.     newline;
  68.     putstr("Press RETURN after you have chosen your number:  ");
  69.     getstr(@S);
  70.  
  71.     lowbnd := 1;
  72.     hibnd := 1000;
  73.  
  74.     nguesses := guesser;        -- call the guessing routine
  75.     newline;
  76.     putstr("Number of guesses = ");
  77.     putint(nguesses); newline; newline;
  78.  
  79.  
  80.     putstr("Do you wish to play again (CR=yes/N=no) ? ");
  81.     getchar(@ch);
  82.     newline;
  83.     if ch='N' then again := false;
  84.     end if;
  85.   end loop;
  86. End;    -- of the program
  87.